perm filename CHECK.INS[1,JRA] blob
sn#019570 filedate 1973-01-11 generic text, type T, neo UTF8
00100
00200
00300 (DEFPROP VARSIN
00400 (LAMBDA(C)
00500 (PROG (C1 VARS)
00600 A (SETQ C (CDR C))
00700 (COND ((NULL C) (RETURN VARS)))
00800 (SETQ C1 (COND ((NEG (CAR C)) (CDDAR C)) (T (CDAR C))))
00900 (SETQ VARS (APPEND (VARSIN1 C1) VARS))
01000 (GO A)))
01100 EXPR)
01200
01300 (DEFPROP VARSIN1
01400 (LAMBDA(C1)
01500 (PROG (VARS)
01600 A (COND ((NULL C1) (RETURN VARS))
01700 ((VAR (CAR C1)) (SETQ VARS (CONS (CAR C1) VARS)))
01800 ((CONST (CAR C1)) NIL)
01900 (T (SETQ VARS (APPEND (VARSIN1 (CDAR C1)) VARS))))
02000 (SETQ C1 (CDR C1))
02100 (GO A)))
02200 EXPR)
02300
02400 (DEFPROP CHECKINST
02500 (LAMBDA(Z C D)
02600 (PROG (Z1 Z2)
02650 (COND((NULL Z)(RETURN T)))
02700 (SETQ Z2(APPEND(VARSIN C)(VARSIN D)))
02800 (COND((NULL Z2)(RETURN T)))
03000 A(SETQ Z1(CONS(CAAR Z) Z1))
03050 (SETQ Z(CDR Z))(COND(Z(GO A)))
03075 B(COND((NULL Z2)(RETURN T))
03087 ((NOT(MEMQ(CAR Z2)Z1))(RETURN NIL)))
03093 (SETQ Z2(CDR Z2))(GO B)
03800 ))
03900 EXPR)
04000
04100 (DEFPROP RESOLVE1
04200 (LAMBDA(C D)
04300 (PROG (CB DB DB1 YC YD YD1 Z X Y RES)
04400 (COND ((AND COND (EVAL COND)) (ERR (CDR LCL))))
04500 (SETQ YC (CDR C))
04600 (SETQ CB (POSBIT C))
04700 (SETQ YD1 (NEGL D))
04800 (SETQ DB1 (NEGBIT D))
04900 (SETQ DB DB1)
05000 (SETQ YD YD1)
05100 RES1 (SETQ X (CAR YC))
05200 (COND ((NEG X) (RETURN RES)))
05300 (SETQ Y (CAR YD))
05400 (COND ((ORDERP (CAR X) (CADR Y)) (GO RES3)) ((NOT (EQ (CAR X) (CADR Y))) (GO RES4)))
05500 (SETQ YD1 YD)
05600 (SETQ DB1 DB)
05700 (GO RES2A)
05800 RES2 (SETQ Y (CAR YD))
05900 (COND ((NOT (EQ (CAR X) (CADR Y))) (GO RES3A)))
06000 RES2A
06100 (COND ((NOT (UNIFAB (CAR CB) (CAR DB))) (GO RES2B)))
06200 (SETQ Z (UNIFY (CDR X) (CDDR Y)))
06300 (COND ((NULL Z) (GO RES2B)))
06350 (COND((NOT(CHECKINST (CDR Z) C D))(GO RES2B)))
06400 (SETQ PARRES NIL)
06500 (SETQ Z (UNION (CDR Z) C D X Y))
06600 (COND ((NULL Z) (GO RES2B)) ((NULL (CAR Z)) (RETURN Z)))
06700 (SETQ RES (CONS (SET2 (CAR (COND (DLIST (DEMOD Z DLIST)) (T Z))) TBL) RES))
06800 RES2B
06900 (SETQ YD (CDR YD))
07000 (COND (YD (SETQ DB (CDR DB)) (GO RES2)))
07100 RES3A
07200 (SETQ DB DB1)
07300 (SETQ YD YD1)
07400 RES3 (SETQ YC (CDR YC))
07500 (COND (YC (SETQ CB (CDR CB)) (GO RES1)))
07600 (RETURN RES)
07700 RES4 (SETQ YD (CDR YD))
07800 (COND (YD (SETQ DB (CDR DB)) (GO RES1)))
07900 (GO RES3A)))
08000 EXPR)